{$ifndef modif}{$i modif.inc}{$endif}

unit graf6;	{Program pro kresleni grafu funkci Turbo-Pascalu V6.
		 M. Navara, 3.1991 - corrected 1994 F&Tsoft}
interface
{$ifdef Graph}
uses    {$ifdef crtx}crtx,{$else}crt,{$endif}
	graph;

procedure OSY;{nacte meze souradnic, prejde do grafickeho rezimu a nakresli osy}

procedure USECKA(x1, y1, x2,y2 : real);{Kresli usecku s koncovymi body [ x1,y1 ],[ x2,y2 ]}

procedure Krizek(x,y : real);     {nakresli krizek v bode [x,y]}

procedure Bod(x,y : real);     {nakresli bod v bode [x,y]}

type funkce = function (x: real): real;

procedure Graf(f: funkce);     {nakresli graf funkce f}

procedure Scale(xm,ym,xv,yv:real);     {definuje meritko obrazovky}

Procedure GrafPort(xm,ym,xv,yv:word);  {definuje plochu pro graf na obrazovce}

Function OpenGraph:Boolean;

Procedure CloseGraph;          {ukonci graficky rezim}

procedure InstalVGAbgi(drv,moddrv:byte);



var xmin,xmax,ymin,ymax  : real;  {meze souradnic}
const grafcolor:byte=green;
      TypCary:Byte=0;		  {0 .. 3}


const PZ:Byte=8;
      rozmerX :word =552 ;
      dolniX  :word =87;   { rozmerX+dolniX=639 }
      rozmerY :word =188 ; dolniY:Word= 18;   { rozmerY+dolniY=199 }
      xpoc    :word =  0 ; xkon :word = 639;
      ypoc    :word =  0 ; ykon :word = 199;
      zadanemeritko :boolean=false;
      zadanaplocha :boolean=False;


implementation

var Grdriver,Grmode: integer;
    JsouOsy: boolean;
    ii:byte;
const SuggestedMode :integer = 0;
      PathToDriver :array[1..5] of string[10] =
		 ('c:\bp\bgi','d:\bp\bgi','g:\bp\bgi','x:\tp\bgi','');
      		   {'D:\PAS';   Stores the DOS path to *.BGI & *.CHR }
{$F+}
function DetectVGA : integer;
{ Detects VGA or MCGA video cards }
var
  DetectedDriver,s : integer;
begin
  DetectGraph(DetectedDriver, S);
  if (DetectedDriver = EGA) or (DetectedDriver = VGA) then
          DetectVGA := SuggestedMode
  else
    DetectVGA := grError; { Couldn't detect hardware }
end; { DetectVGA256 }
{$F-}

procedure InstalVGAbgi(drv,moddrv:byte);

var AutoDetectPointer : pointer;

begin
SuggestedMode:=moddrv;
AutoDetectPointer := @DetectVGA;
GrDriver := InstallUserDriver('SVGAS3',AutoDetectPointer);{}
{GrDriver := InstallUserDriver('svga256',AutoDetectPointer);{}
GrDriver := Detect;
end;

function iround(x :real) :integer;
begin if x > maxint then iround:=maxint
      else if x < -maxint then iround:=-maxint
      else iround:=round(x)
end;

function trx(x : real) : integer;
begin trx := iround(rozmerx/(xmax-xmin)*(x-xmin))
end;

function try(y : real) : integer;
begin try := iround(rozmery/(ymin-ymax)*(y-ymax))
end;

procedure SCALE(xm,ym,xv,yv:real);
begin
 zadanemeritko:=true;
 xmin:=xm;
 xmax:=xv;
 ymin:=ym;
 ymax:=yv;
 JsouOsy:=False;
end;

Procedure GrafPort(xm,ym,xv,yv:word);
begin
 if Xv > GetMaxX then xv:=GetMaxX;
 if Yv > GetMaxX then xv:=GetMaxX;
 Xpoc:=Xm;
 Xkon:=Xv;
 Ypoc:=Ym;
 Ykon:=Yv;
 rozmerX:=Xkon-dolniX-Xpoc;
 rozmerY:=Ykon-dolniy-Ypoc;
 ZadanaPlocha:=True;
 JsouOsy:=False;
end;


procedure Svga;
begin
ii:=GetPixel(1,1);  {to tam musi byt i kdyz je to na nic !}
end;


procedure OSY;

const DelkaRadku = 80;
type string80 = string[80];

var st: string80;
    xi,yi,i : integer;

label rep,1;

procedure PisRealFStr (x: real; PZ: integer; var st: string80);
var delka, i, ex: integer;
begin
      if PZ < 8 then PZ:=8;
      if PZ > 80 then PZ:=80;
      delka:=PZ;
      if delka > 23 then delka:=23;
      if abs(x) < 1e-30 then Str(0.0 :delka :delka-4, st)
      else
      begin ex:= trunc(ln(abs(x))/ln(10));   { exponent }
            if (delka-ex-3 < 0) or (ex > 14) or (ex < -4) then  { exp. tvar }
            begin Str(abs(x) :delka-2, st);
                  if x < 0 then st[1]:='-';       {vynechani mezery}
                  for i:=delka to PZ do Insert(' ', st, 1)
            end
            else if ex < 0 then Str(x :PZ :delka-4, st)
            else if delka-ex-3 = 0 then Str(x :PZ :0, st)
            else Str(x :PZ :delka-ex-4, st)
      end;
delete(st,1,1);   {vynechani mezery}
end;  { PisRealFStr }

begin    { OSY }
if not zadanemeritko then
   begin
       rep:
          writeln;
          textcolor(2); gotoXY(70,WhereY); writeln('MiNa 3/91'); textcolor(10);
          writeln('Zadej meze souradnic (xmin xmax ymin ymax)');
          write('xmin:= '); read(xmin);
          write('xmax:= '); read(xmax);
          write('ymin:= '); read(ymin);
          write('ymax:= '); read(ymax);
          if (xmax <= xmin) or (ymax <= ymin) then
             begin textbackground(4);
                   textcolor(15);
                   writeln('Dolni mez musi byt mensi nez horni! ');
                   textbackground(0);
                   textcolor(0); writeln(char($07),char($4d),char($4e));
                   textcolor(10);
                   goto rep
             end;
    end;

 if not(mem[$40:$49] in [4..6,13 .. 19]) then {inicializace grafiky}
   begin
   if not(OpenGraph) then
       begin
       Writeln('Graphics error: ', GraphErrorMsg(GraphResult));
       Halt(1);                      { Some other error: terminate }
       end
   end
   else
   begin
   dolniY:=textheight('0')+4;
   dolniX:=(PZ-1)*textWidth('0')-1+textWidth('.');
   ClearViewPort;
   end;
 1:
 setcolor(white);   {????}
 if not(zadanaplocha) then GrafPort(0,0,GetMaxX,GetMaxY);
 SetViewPort(Xpoc+dolnix,Ypoc,Xkon,Ykon,true);
 line(0,0,rozmerx,0);  {ramecek}
 line(rozmerx,0,rozmerx,rozmery);
 line(rozmerx,rozmery,0,rozmery);
 line(0,rozmery,0,0);
          for i:=1 to 3 do
          begin xi:=round(i*rozmerx/4);
                line(xi,rozmery,xi,rozmery-2)
          end;
          for i:=1 to 3 do
          begin yi:=round(i*rozmery/4);
                line(0,yi,4,yi)
          end;
          if (0>xmin) and (0<xmax) then           {osa y}
          begin xi:=trx(0); line(xi,0,xi,rozmery);
              for i:=1 to 3 do
              begin yi:=round(i*rozmery/4);
                    line(xi,yi,xi+4,yi)
              end;
          end;
          if (0>ymin) and (0<ymax) then           {osa x}
          begin yi:=try(0); line(0,yi,rozmerx,yi);
              for i:=1 to 3 do
              begin xi:=round(i*rozmerx/4);
                    line(xi,yi,xi,yi-2)
              end;
          end;
   SetViewPort(Xpoc,Ypoc,Xkon,Ykon,true);  {!!!!!!!!}
   PisRealFStr(ymin,PZ,st); OutTextXY(0,rozmery-8,st);        {popis osy y}
   PisRealFStr(ymin+(ymax-ymin)/4,PZ,st); OutTextXY(0,round(rozmery*3/4)-4,st);
   PisRealFStr(ymin+(ymax-ymin)/2,PZ,st); OutTextXY(0,round(rozmery/2)-4,st);
   PisRealFStr(ymin+(ymax-ymin)*3/4,PZ,st); OutTextXY(0,round(rozmery/4)-4,st);
   PisRealFStr(ymax,PZ,st); OutTextXY(0,0,st);
   PisRealFStr(xmin,PZ,st); OutTextXY(dolnix-44,rozmery+4,st);         {popis osy x}
   PisRealFStr(xmin+(xmax-xmin)/4,PZ,st); OutTextXY(dolnix-44+round(rozmerx/4),rozmery+4,st);
   PisRealFStr(xmin+(xmax-xmin)/2,PZ,st); OutTextXY(dolnix-44+round(rozmerx/2),rozmerY+4,st);
   PisRealFStr(xmin+(xmax-xmin)*3/4,PZ,st); OutTextXY(dolnix-44+round(rozmerx*3/4),rozmerY+4,st);
   PisRealFStr(xmax,PZ,st); OutTextXY(dolnix-80+rozmerx,rozmerY+4,st);
JsouOsy:=true;
end;  { osy }

procedure USECKA(x1, y1, x2,y2 : real);
     {Kresli usecku s koncovymi body [ x1,y1 ],[ x2,y2 ].}
var tc : byte;
    n,i : integer;
    p,d : real;
begin
if not(JsouOsy) then osy;
SetViewPort(Xpoc+dolnix,Ypoc,Xkon,Ykon,true);
      tc:=TypCary mod 4;
      if tc=1 then line(trx(x1),try(y1),trx(x2),try(y2))
      else
      begin d:=sqrt(sqr((0.0+trx(x1)-trx(x2))/2)+sqr(0.0+try(y1)-try(y2)));
            case tc of
            2:   begin d:=d-6; n:=round(d/9); p:=6/9 end;
            3:   begin d:=d-3; n:=round(d/7); p:=3/7 end;
            else begin d:=d-1; n:=round(d/7); p:=1/7 end
            end;
            for i:=0 to n do
                line(trx(x1+(x2-x1)*i/n),try(y1+(y2-y1)*i/n),
                     trx(x1+(x2-x1)*(i+p)/n),try(y1+(y2-y1)*(i+p)/n));
      end;
SetViewPort(0,0,GetMaxX,GetMaxY,true);
end;

procedure KRIZEK(x,y : real);     {nakresli krizek v bode [x,y]}
var xs,ys : word;
begin
if not(JsouOsy)  then osy;
SetViewPort(Xpoc+dolnix,Ypoc,Xkon,Ykon,true);
ii:=GetPixel(1,1);  {to tam musi byt i kdyz je to na nic !}
xs := trx(x);
ys := try(y);
line(xs-6,ys,xs+6,ys);
line(xs,ys-6,xs,ys+3);
SetViewPort(0,0,GetMaxX,GetMaxY,true);
end;

procedure Bod(x,y : real);     {nakresli bod v bode [x,y]}
begin
 if not(JsouOsy) then osy;
 SetViewPort(Xpoc+dolnix,Ypoc,Xkon,Ykon,true);
 ii:=GetPixel(1,1);  {to tam musi byt i kdyz je to na nic !}
 PutPixel(trx(x),try(y),GrafColor);
SetViewPort(0,0,GetMaxX,GetMaxY,true);
end;

procedure graf(f: funkce);
var d : boolean;
    tc : byte;
    xn,yo,yn : integer;
    x,h : real;
begin
if not(JsouOsy)  then osy;
SetViewPort(Xpoc+dolnix,Ypoc,Xkon,Ykon,true);
SetColor(GrafColor);
ii:=GetPixel(1,1);  {to tam musi byt i kdyz je to na nic !}
      h := (xmax - xmin)/rozmerx;
      tc:=TypCary mod 4;
      x:=xmin;
      yo:=try(f(xmin));
      for xn:=1 to rozmerx do
          begin
              x := x+h;
              yn:=try(f(x));
              case tc of 0:   d:=true;
			 1:   d:=xn mod 6 < 4;
			 2:   d:=xn mod 5 < 2;
		   else d:=False;
              end;
          if d then line(xn-1,yo,xn,yn)
	       else PutPixel(xn,yn,grafcolor);
          yo:=yn;
          end;
SetViewPort(0,0,GetMaxX,GetMaxY,true);
end;   { graf }

Function OpenGraph:Boolean;
Var OldFileMode:integer;
    i:byte;
Label 1;
begin
OpenGraph:=False;
 OldFileMode:=filemode;
 filemode:=0;
   for i:=1 to 4 do
      	begin
        Grdriver:=detect;          {detect<<<<<}
        InitGraph(Grdriver,GrMode,PathToDriver[i]);  {'x:\tp\bgi');}
        if GraphResult = grOK then
		begin
                OpenGraph:=True;
		Goto 1;           { not error? }
                end;
        end;
1:
 filemode:=OldFileMode
end;

procedure CloseGraph;
begin
 Graph.CloseGraph;
 JsouOsy:=False;
end;

begin
   JsouOsy:=false;
   TypCary:=0;
   DirectVideo:=False;

{$else}
implementation
{$endif}
end.
